﻿module internal Octopus.OctopusService.FunctionsCore

open System
open System.IO
open Octopus.OctopusLib
open Octopus.OctopusService.General


//----------------------------------------------------------------------------


let updateVmState (vm:VirtualMachine) =
  // Patch: do not update the state when migrating
  if vm.OctopusState <> OctopusVmState.Migrating then
    let hfvm = HyperF.HyperF.get_VMSummary (Some vm.CurrentServer) vm.HyperVGuid
    Database.VirtualMachines.updateVirtualMachineHyperVStates2 vm.OctopusGuid (Some hfvm.State) (Some hfvm.HealthState) (Some hfvm.Heartbeat)

let updateVmState2 (hfvm:HyperF.VirtualMachineSummary) =
  let vm = Database.VirtualMachines.getVmByHyperVGuid hfvm.Guid
  // Patch: do not update the state when migrating
  if vm.OctopusState <> OctopusVmState.Migrating then
    Database.VirtualMachines.updateVirtualMachineHyperVStates2 vm.OctopusGuid (Some hfvm.State) (Some hfvm.HealthState) (Some hfvm.Heartbeat)


//----------------------------------------------------------------------------

module internal Utility =
  let getParamNote (note:string) (param:string) =
    if note.Trim() = "" then null
    else if not(note.Contains("=")) then null
    else
      let split = note.Split([|';'|]) |> Array.map (fun x -> let s = x.Split([|'='|],2) in (s.[0].Trim(),s.[1].Trim()))
      try let p = split |> Array.find (fun (x,y) -> x = param)
          snd p
      with _ -> null
  
  let removeParamNote (note:string) (param:string) =
    if note.Trim() = "" then ""
    else if not(note.Contains("=")) then note
    else
      let split = note.Split([|';'|]) |> Array.map (fun x -> let s = x.Split([|'='|],2) in (s.[0].Trim(),s.[1].Trim()))
      let tmp = split |> Array.filter (fun (x,y) -> x <> param)
      tmp |> Array.map (fun (x,y) -> sprintf "%s=%s" x y) |> String.concat "; "

  let setParamNote (note:string) (param:string) (value:string) =
    if note.Trim() <> "" && not(note.Contains("=")) then failwith "Invalid notes format"
    let tmp = removeParamNote note param
    if tmp = "" then sprintf "%s=%s" param value
    else sprintf "%s; %s=%s" tmp param value

  let serialize (obj:obj) =
    let formatter = new System.Runtime.Serialization.Formatters.Binary.BinaryFormatter()
    use stream = new MemoryStream()
    formatter.Serialize(stream, obj)
    stream.Seek(0L, SeekOrigin.Begin) |> ignore
    let data = Array.zeroCreate<byte> (int stream.Length)
    stream.Read(data, 0, (int stream.Length)) |> ignore
    System.Convert.ToBase64String(data)

  let deserialize str =
    let data = System.Convert.FromBase64String(str)
    use stream = new MemoryStream()
    stream.Write(data, 0, data.Length) |> ignore
    stream.Seek(0L, SeekOrigin.Begin) |> ignore
    let formatter = new System.Runtime.Serialization.Formatters.Binary.BinaryFormatter()
    formatter.Deserialize(stream)

  let copyStream (inputStream:Stream) (outputStream:Stream) =
    let bufferSize = if inputStream.Length < 4096L then (int inputStream.Length) else 4096
    let buffer = Array.create<byte> bufferSize 0uy
    let mutable bytesRead = 0
    while (bytesRead <- inputStream.Read(buffer, 0, buffer.Length); bytesRead) <> 0 do
      outputStream.Write(buffer, 0, bytesRead)

  let rec directoryCopy sourceDirectory targetDirectory =
    let source = new DirectoryInfo(sourceDirectory)
    let target = new DirectoryInfo(targetDirectory)

    // Check if the target directory exists, if not, create it
    if not(Directory.Exists(target.FullName)) then
      Directory.CreateDirectory(target.FullName) |> ignore

    // Copy each file into it's new directory
    for fi in source.GetFiles() do
      fi.CopyTo(Path.Combine(target.ToString(), fi.Name), true) |> ignore

    // Copy each subdirectory using recursion
    for diSourceSubDir in source.GetDirectories() do
      let nextTargetSubDir = target.CreateSubdirectory(diSourceSubDir.Name)
      directoryCopy diSourceSubDir.FullName nextTargetSubDir.FullName

  let trySomeTimes (times,delay:int) (f:unit -> unit) =
    let timesTried = ref 0
    let rec doJob ttl =
      timesTried := !timesTried + 1
      if ttl > 0 then
        try f()
        with _ ->
          System.Threading.Thread.Sleep(delay)
          doJob (ttl-1)
      else f()
    doJob times
    !timesTried

// Utility end
//----------------------------------------------------------------------------

let getDomainInfo =
  let d = Database.GeneralConfig.get_AdminCredentialsDomain ()
  let u = Database.GeneralConfig.get_AdminCredentialsUsername ()
  let p = Database.GeneralConfig.get_AdminCredentialsPassword ()
  fun x -> match x with
           | "Name" -> d
           | "User" -> u
           | "Pass" -> p
           | _ -> failwith "Invalid property"

//-------------------------------------------
// Deploying stuff


let instanceDeployDisk vfdPath (conf:Octopus.VMDeployer.ConfigurationData) =
  let buffer =
      let deployDiskPath = (getFile getServiceBinPath "DeployDisk.zip").FullName
      use zip = Packaging.ZipPackage.Open(deployDiskPath, FileMode.Open, FileAccess.Read)
      let part = [| for p in zip.GetParts() -> p |].[0]
      use partStream = part.GetStream()
      use ms = new MemoryStream(int partStream.Length)
      Utility.copyStream partStream ms
      let b = ms.ToArray()
      ms.Close()
      partStream.Close()
      zip.Close() 
      b
  
  let confData = conf.ToByteArray_PlainXml()
  
  //16896 - BEGIN TO WRITE HERE
  for i = 0 to (confData.Length-1) do buffer.[i+16896] <- confData.[i]
  
  use ms = new MemoryStream(buffer)
  use fs = new FileStream(vfdPath, FileMode.Create)
  Utility.copyStream ms fs
  fs.Close()
  ms.Close()


(*
let instanceHpcXmlNodeImport (path:string) (hostname:string) (domain:string) (vmGuid:System.Guid) (macAddress:string) =
  let template =
      [| @"<?xml version=""1.0"" encoding=""utf-8""?>";
         @"<Nodes xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" xmlns=""http://schemas.microsoft.com/HpcNodeConfigurationFile/2007/12"">";
         @"  <Node";
         sprintf @"    Name=""%s""" hostname;
         sprintf @"    Domain=""%s""" domain;
         sprintf @"    MachineGuid=""{%s}"">" (vmGuid.ToString());
         @"    <Template Name=""Octopus ComputeNode Template"" />";
         sprintf @"    <MacAddress>%s</MacAddress>" macAddress;
         @"  </Node>";
         @"</Nodes>" |]
  use sw = new System.IO.StreamWriter(path, AutoFlush=true)
  for line in template do sw.WriteLine(line)
  sw.Close()
*)


let createNewVm (vmp:VirtualMachinePendingCreation) =
  let vmTemplate = Database.VMTemplates.getVMTemplate vmp.VmTemplateID
  let hypervNode = Database.HyperVNodes.getHyperVNodeByName vmp.HostServer
  let diskParent = vmTemplate.VhdPath

  let memorySizeMb = int(vmp.MemorySize / 1048576UL)
  
  // check the directory to save the VM
  (*
  let saveVmPath = 
      let rec findNewName saveVmPath i =
        let newName = sprintf "%s(%d)" saveVmPath i
        if Directory.Exists(newName) then findNewName saveVmPath (i+1)
        else newName
      let path = Database.GeneralConfig.get_SharedStoragePath ()
      let tmp = if path.EndsWith("\\") then path else (path + "\\")
      let tmp = sprintf "%sVirtualMachines\\%s" tmp vmd.HostName
      if Directory.Exists(tmp) then findNewName tmp 1 else tmp
  *)
  let parentVmPath = Database.GeneralConfig.get_SharedStoragePath ()

  //check for the NIC name in Hyper-V
  let switch = HyperF.HyperF.get_AllVMSwitch (Some vmp.HostServer) |> Array.find (fun x -> x.Guid = hypervNode.ExternalNIC_Guid)

  // Create the Virtual Machine
  let hfvm = match parentVmPath with
             | null -> HyperF.HyperF.new_VM (Some vmp.HostServer) vmp.HostName
             | _ -> HyperF.HyperF.new_VM_To (Some vmp.HostServer) vmp.HostName parentVmPath

  // update the VM Path with the directory created by Hyper-V
  let saveVmPath = sprintf "%s\\Virtual Machines\\%s" parentVmPath (hfvm.Guid.ToString().ToUpper())

  // Create a new differencing hard disk from the Parent specified
  let saveVhdPath =
      sprintf "%s\\%s.vhd" saveVmPath vmp.HostName
  HyperF.HyperF.new_VHD_Differencing (Some hypervNode.HostName) saveVhdPath diskParent

  // Change the GUID of the virtual machine (changing the name of the export file)
  (*
  let exportPath = saveVmPath + "\\ExportTmp"
  HyperF.HyperF.exportEx_VM hfvm exportPath false false
  HyperF.HyperF.delete_VM hfvm false |> ignore
  let path1 = exportPath + "\\Virtual Machines\\" + hfvm.Guid.ToString() + ".exp"
  let path2 = saveVmPath + "\\Virtual Machines\\" + vmp.Guid.ToString() + ".exp"
  File.Move(path1, path2)
  Directory.Delete(exportPath, true)
  Utility.trySomeTimes (5,2000) (fun () -> HyperF.HyperF.importEx_VM (Some hfvm.Server) hfvm.Name false saveVmPath false "") |> ignore
  let hfvm = HyperF.HyperF.get_VM (Some hfvm.Server) vmp.Guid
  *)

  // Create the disk (vfd) for the deployment
  let deployDiskPath = saveVmPath + @"\DeployDisk.vfd"
  let octopusAddresses = let host = System.Net.Dns.GetHostName() in [| yield host; for a in System.Net.Dns.GetHostAddresses(host) do yield string a |]
  let conf = new Octopus.VMDeployer.ConfigurationData(vmp.OctopusGuid, vmp.HostName, vmp.OwnerName, vmp.Password, Guid.Empty, octopusAddresses)
  (* if vmTemplate.IsHpcNode then
    let domainName = getDomainInfo "Name"
    let domainUser = getDomainInfo "User"
    let domainPass = getDomainInfo "Pass"
    conf.AddAction (new Octopus.VMDeployer.DeployHpcNode(vmTemplate.HpcScheduler, domainName, (domainUser,domainPass))) *)
  instanceDeployDisk deployDiskPath conf

  // Set basic settings
  HyperF.HyperF.set_VMCPUCount hfvm (int vmp.CpuCount)
  HyperF.HyperF.set_VMMemory hfvm memorySizeMb

  // Add a legacy NIC to the new VM
  HyperF.HyperF.add_VMNic hfvm (Some switch) true None

  // Connect the hard disk to the VM
  let controllers = HyperF.HyperF.get_VMDiskControllers hfvm
  HyperF.HyperF.add_VMHardDiskToController controllers.[0] 0 saveVhdPath

  // the add_VMFloppyDisk fails before it passes some seconds...
  Utility.trySomeTimes (15,5000) (fun () -> HyperF.HyperF.add_VMFloppyDisk hfvm deployDiskPath) |> ignore

  let vmd = vmp :> VirtualMachineData
  new VirtualMachine(vmd, hfvm.Guid, OctopusVmState.ScheduledForConfiguring, HyperVState.Stopped, HyperVHealthState.OK,
                     HyperVHeartbeat.NoContact, 0, System.DateTime.Now, hfvm.Server, parentVmPath,
                     false, System.Net.IPAddress.None)


(*
let createAllVmRequested (vmGuid:Guid) (onNodes:string array) =
  let vmr = Database.VirtualMachines.getVmRequestedBuGuid vmGuid
  let hosts = parseMultipleHostname vmr.HostName

  if int(vmr.NumberOfVm) <> hosts.Length then
      failwith "The hostname provided doesn't match the number of virtual machine specified"

  for i = 0 to (int vmr.NumberOfVm - 1) do
      let vmri = new VirtualMachineRequested(-1, Guid.NewGuid(), 1us, vmr.OwnerName, (hosts.[i]), vmr.CpuCount, vmr.MemorySize, vmr.VmTemplateID, vmr.Password)
      createNewVm vmri (onNodes.[i]) |> ignore
*)


let allowRequestOfNewVm (requestGuid:Guid) (onNodes:string array) =
  let vmr = Database.VirtualMachines.getVmRequestedByGuid requestGuid
  if int(vmr.NumberOfVm) <> onNodes.Length then
      failwith "The hostname provided doesn't match the number of virtual machine specified"
  Database.VirtualMachines.moveVMRequestInPendingCreation vmr onNodes

  let pendingVMs = Database.VirtualMachines.getAllVmInPendingCreation ()

  for vmp in pendingVMs do
    try
      let vm = createNewVm vmp
      Database.VirtualMachines.movePendingVmToActive vmp vm
    with e ->
      Database.LogFile.writeInLog (sprintf "-- allowRequestOfNewVm(%s) catched an exception: %s\r\n%s" vmp.HostName e.Message e.StackTrace)


let denyRequestOfNewVm (requestGuid:Guid) =
  Database.VirtualMachines.denyVMRequest requestGuid


//------------------------------------------------------------------------
// Checkpoint stuff

let groupVms (vms:VirtualMachine array) =
  let lst = new System.Collections.Generic.List<string>()
  vms |> Array.iter (fun x -> if not(lst.Contains(x.CurrentServer)) then lst.Add(x.CurrentServer))
  [| for s in lst -> (vms |> Array.filter (fun x -> x.CurrentServer = s)) |]

let getHyperFGrouped (gvms:VirtualMachine[] array) =
  let f (vms:VirtualMachine array) = async { return [| for v in vms -> (v, HyperF.HyperF.get_VM (Some v.CurrentServer) v.HyperVGuid) |] }
  Async.Parallel [ for vms in gvms -> f vms ] |> Async.RunSynchronously

// Specifying the newHost parameter you can simultaneously checkpoint and migrate the VM
// WARNING: The migration is in-place and there isn't any check about storage visbility,
//          so, do not pass hostnames in which you can't migrate in-place !
let set_VMCheckpoint (vm:VirtualMachine, hfvm:HyperF.VirtualMachine) (newHost:HyperVNode option) =
  let checkpointPath = vm.StoredPath + "\\Checkpoint"
  let exportTmpPath = vm.StoredPath + "\\ExportTmp"

  let disks = HyperF.HyperF.get_VMDisks hfvm
  let disk = disks.[0].Connection.[0]
  let newDisk = disk.Substring(0, disk.IndexOf('.')) + ".Child.vhd"

  // Step 0: Check if the VM is already checkpointed
  if vm.IsCheckpointed then
    failwithf "The VM \"%s\" is already checkpointed" vm.HostName
  if File.Exists(newDisk) then
    failwithf "The VM \"%s\" is already checkpointed" vm.HostName
  if Directory.Exists(checkpointPath) then
    failwithf "The VM \"%s\" is already checkpointed" vm.HostName

  // (refresh the vm information)
  let hfvm = HyperF.HyperF.get_VM (Some vm.CurrentServer) vm.HyperVGuid
  
  // (update the database)
  Database.VirtualMachines.updateVirtualMachineOctopusState vm.OctopusGuid OctopusVmState.Checkpointing

  // Step 1: Suspend the VM
  match hfvm.State with
  | HyperF.VMState.Paused
  | HyperF.VMState.Running -> HyperF.HyperF.suspend_VM hfvm
  | HyperF.VMState.Stopped
  | HyperF.VMState.Suspended -> ()
  | x -> failwithf "Unable to checkpoint the vm when %s" (x.ToString())

  // Step 2: Moves the vm state to backup it, before deleting the vm
  let path1 = vm.StoredPath + "\\Virtual Machines\\" + (string vm.HyperVGuid)
  let path2 = checkpointPath + "\\" + (string vm.HyperVGuid)
  Directory.CreateDirectory(checkpointPath) |> ignore
  Directory.Move(path1, path2)
  
  // (update the database)
  Database.VirtualMachines.updateVirtualMachineCheckpointState vm.OctopusGuid true

  // Step 3: Export the VM without copying the state nor the storage
  //         This is the export used to revert/merge the checkpoint
  HyperF.HyperF.exportEx_VM hfvm checkpointPath false false

  // (refresh the vm information)
  let hfvm = HyperF.HyperF.get_VM (Some vm.CurrentServer) vm.HyperVGuid

  // Step 3: Delete saved state (if suspended) and remove the hard drive
  if hfvm.State = HyperF.VMState.Suspended then
    HyperF.HyperF.stop_VM hfvm
  HyperF.HyperF.remove_VMDrive (disks.[0].DiskDrive)

  // Step 4: Create the differencing disk
  HyperF.HyperF.new_VHD_Differencing (Some vm.CurrentServer) newDisk disk
  
  // Step 5: Adding the new differencing disk
  let controllers = HyperF.HyperF.get_VMDiskControllers hfvm
  HyperF.HyperF.add_VMHardDiskToController controllers.[0] 0 newDisk

  // Step 6: Export the VM without copying the state nor the storage
  //         This is the export used to reimport immediately the VM
  HyperF.HyperF.exportEx_VM hfvm exportTmpPath false false

  // Step 7: Edit the export xml file, to set that the state was copied
  // --> only if the VM was in Suspended state
  if hfvm.State = HyperF.VMState.Suspended then
      let path1 = checkpointPath + "\\Virtual Machines\\" + (string vm.HyperVGuid) + ".exp"
      let sb = new System.Text.StringBuilder()
      use sr = new StreamReader(path1, System.Text.Encoding.Unicode)
      sb.Append(sr.ReadToEnd()) |> ignore
      sr.Close()
      let cut = @"<INSTANCE CLASSNAME=""Msvm_VirtualSystemExportSettingData""><PROPERTY NAME=""Caption"" TYPE=""string""><VALUE>Virtual System Export Setting Data</VALUE></PROPERTY><PROPERTY NAME=""CopySnapshotConfiguration"" TYPE=""uint8""><VALUE>0</VALUE></PROPERTY><PROPERTY NAME=""CopyVmRuntimeInformation"" TYPE=""boolean""><VALUE>FALSE"
      let paste = @"<INSTANCE CLASSNAME=""Msvm_VirtualSystemExportSettingData""><PROPERTY NAME=""Caption"" TYPE=""string""><VALUE>Virtual System Export Setting Data</VALUE></PROPERTY><PROPERTY NAME=""CopySnapshotConfiguration"" TYPE=""uint8""><VALUE>0</VALUE></PROPERTY><PROPERTY NAME=""CopyVmRuntimeInformation"" TYPE=""boolean""><VALUE>TRUE"
      sb.Replace(cut, paste) |> ignore
      use sw = new StreamWriter(path1, false, System.Text.Encoding.Unicode)
      sw.Write(sb.ToString())
      sw.Flush()
      sw.Close()

      let path1 = exportTmpPath + "\\Virtual Machines\\" + (string vm.HyperVGuid) + ".exp"
      let sb = new System.Text.StringBuilder()
      use sr = new StreamReader(path1, System.Text.Encoding.Unicode)
      sb.Append(sr.ReadToEnd()) |> ignore
      sr.Close()
      let cut = @"<INSTANCE CLASSNAME=""Msvm_VirtualSystemExportSettingData""><PROPERTY NAME=""Caption"" TYPE=""string""><VALUE>Virtual System Export Setting Data</VALUE></PROPERTY><PROPERTY NAME=""CopySnapshotConfiguration"" TYPE=""uint8""><VALUE>0</VALUE></PROPERTY><PROPERTY NAME=""CopyVmRuntimeInformation"" TYPE=""boolean""><VALUE>FALSE"
      let paste = @"<INSTANCE CLASSNAME=""Msvm_VirtualSystemExportSettingData""><PROPERTY NAME=""Caption"" TYPE=""string""><VALUE>Virtual System Export Setting Data</VALUE></PROPERTY><PROPERTY NAME=""CopySnapshotConfiguration"" TYPE=""uint8""><VALUE>0</VALUE></PROPERTY><PROPERTY NAME=""CopyVmRuntimeInformation"" TYPE=""boolean""><VALUE>TRUE"
      sb.Replace(cut, paste) |> ignore
      use sw = new StreamWriter(path1, false, System.Text.Encoding.Unicode)
      sw.Write(sb.ToString())
      sw.Flush()
      sw.Close()

  // Step 8: Delete the vm, without deleting the storage  
  HyperF.HyperF.delete_VM hfvm false |> ignore
  
  // Step 9: Restore the backuped state
  let path1 = exportTmpPath + "\\Virtual Machines"
  let path2 = vm.StoredPath + "\\Virtual Machines"
  if Directory.Exists(path2) then Directory.Delete(path2, true)
  Utility.trySomeTimes (10,1000) (fun () -> Directory.Move(path1, path2)) |> ignore
  let path1 = checkpointPath + "\\" + (string vm.HyperVGuid)
  let path2 = vm.StoredPath + "\\Virtual Machines\\" + (string vm.HyperVGuid)
  Utility.directoryCopy path1 path2
  Directory.Delete(exportTmpPath, true)

  // Step 10: Reimport the VM
  let foo = 
    match newHost with
    | None -> fun () -> HyperF.HyperF.importEx_VM (Some vm.CurrentServer) vm.HostName false vm.StoredPath false ""
    | Some(s) -> fun () -> HyperF.HyperF.importEx_VM (Some s.HostName) vm.HostName false vm.StoredPath false ""
  Utility.trySomeTimes (5,2000) foo |> ignore

  // (update the database)
  Database.VirtualMachines.updateVirtualMachineOctopusState vm.OctopusGuid OctopusVmState.Normal



// Specifying the newHost parameter you can simultaneously checkpoint and migrate the VM
// WARNING: The migration is in-place and there isn't any check about storage visbility,
//          so, do not pass hostnames in which you can't migrate in-place !
let discard_VMCheckpoint (vm:VirtualMachine, hfvm:HyperF.VirtualMachine) (newHost:HyperVNode option) =
  let checkpointPath = vm.StoredPath + "\\Checkpoint"

  let disks = HyperF.HyperF.get_VMDisks hfvm
  let newDisk = disks.[0].Connection.[0]
  let vhdinfo = HyperF.HyperF.get_VHDInfo (Some vm.CurrentServer) newDisk
  let oldDisk = vhdinfo.ParentPath

  // Step 0: Check if the VM is checkpointed
  if not(Directory.Exists(checkpointPath)) then
    failwith "Checkpoint not found"

  // Step -REMOVED-: Stop the VM
  // It is required that this function is called only on Stopped VMs

  // (update the database)
  Database.VirtualMachines.updateVirtualMachineOctopusState vm.OctopusGuid OctopusVmState.Checkpointing

  // Step 2: Delete the VM and the child vhd
  HyperF.HyperF.delete_VM hfvm false |> ignore
  File.Delete(newDisk)

  // Step 3: Moves the vm state and metadata
  let path1 = checkpointPath + "\\Virtual Machines"
  let path2 = vm.StoredPath + "\\Virtual Machines"
  if Directory.Exists(path2) then Directory.Delete(path2, true)
  Utility.trySomeTimes (10,1000) (fun () -> Directory.Move(path1, path2)) |> ignore
  let path1 = checkpointPath + "\\" + (string vm.HyperVGuid)
  let path2 = vm.StoredPath + "\\Virtual Machines\\" + (string vm.HyperVGuid)
  Directory.Move(path1, path2)
  Directory.Delete(checkpointPath, true)

  // Update the database
  Database.VirtualMachines.updateVirtualMachineCheckpointState vm.OctopusGuid false
  
  // Step 4: Reimport the VM
  let foo = 
    match newHost with
    | None -> fun () -> HyperF.HyperF.importEx_VM (Some vm.CurrentServer) vm.HostName false vm.StoredPath false ""
    | Some(s) -> fun () -> HyperF.HyperF.importEx_VM (Some s.HostName) vm.HostName false vm.StoredPath false ""
  Utility.trySomeTimes (5,2000) foo |> ignore

  // (update the database)
  Database.VirtualMachines.updateVirtualMachineOctopusState vm.OctopusGuid OctopusVmState.Normal


// Specifying the newHost parameter you can simultaneously checkpoint and migrate the VM
// WARNING: The migration is in-place and there isn't any check about storage visbility,
//          so, do not pass hostnames in which you can't migrate in-place !
let commit_VMCheckpoint (vm:VirtualMachine, hfvm:HyperF.VirtualMachine) (newHost:HyperVNode option) =
  let checkpointPath = vm.StoredPath + "\\Checkpoint"

  let disks = HyperF.HyperF.get_VMDisks hfvm
  let newDisk = disks.[0].Connection.[0]
  let vhdinfo = HyperF.HyperF.get_VHDInfo (Some vm.CurrentServer) newDisk
  let oldDisk = vhdinfo.ParentPath

  // Step 0: Check if the VM is checkpointed
  if not(Directory.Exists(checkpointPath)) then
    failwith "Checkpoint not found"

  // (update the database)
  Database.VirtualMachines.updateVirtualMachineOctopusState vm.OctopusGuid OctopusVmState.Checkpointing

  // (refresh the vm information)
  let hfvm = HyperF.HyperF.get_VM (Some vm.CurrentServer) vm.HyperVGuid

  // Step 1: Suspend the VM
  match hfvm.State with
  | HyperF.VMState.Paused
  | HyperF.VMState.Running -> HyperF.HyperF.suspend_VM hfvm
  | HyperF.VMState.Stopped
  | HyperF.VMState.Suspended -> ()
  | x -> failwithf "Unable to merge the state when %s" (x.ToString())

  // (refresh the vm information)
  let hfvm = HyperF.HyperF.get_VM (Some vm.CurrentServer) vm.HyperVGuid

  // Step 2: Moves the vm state to backup it, before deleting the vm
  let path1 = checkpointPath + "\\" + (string vm.HyperVGuid)
  Directory.Delete(path1, true)
  if hfvm.State = HyperF.VMState.Suspended then
    let path2 = vm.StoredPath + "\\Virtual Machines\\" + (string vm.HyperVGuid)
    Directory.Move(path2, path1)

  // Step 3: Delete the VM 
  HyperF.HyperF.delete_VM hfvm false |> ignore

  // Step 4: Moves the vm state and metadata
  let path1 = checkpointPath + "\\Virtual Machines"
  let path2 = vm.StoredPath + "\\Virtual Machines"
  if Directory.Exists(path2) then Directory.Delete(path2, true)
  Utility.trySomeTimes (10,1000) (fun () -> Directory.Move(path1, path2)) |> ignore
  if hfvm.State = HyperF.VMState.Suspended then
    let path1 = checkpointPath + "\\" + (string vm.HyperVGuid)
    let path2 = vm.StoredPath + "\\Virtual Machines\\" + (string vm.HyperVGuid)
    Directory.Move(path1, path2)
  Directory.Delete(checkpointPath, true)

  // Step 5: Merge the child vhd with its parent
  HyperF.HyperF.merge_VHD (Some vm.CurrentServer) newDisk oldDisk

  // Update the database
  Database.VirtualMachines.updateVirtualMachineCheckpointState vm.OctopusGuid false
  
  // Step 6: Reimport the VM
  let foo = 
    match newHost with
    | None -> fun () -> HyperF.HyperF.importEx_VM (Some vm.CurrentServer) vm.HostName false vm.StoredPath false ""
    | Some(s) -> fun () -> HyperF.HyperF.importEx_VM (Some s.HostName) vm.HostName false vm.StoredPath false ""
  Utility.trySomeTimes (5,2000) foo |> ignore

  // (update the database)
  Database.VirtualMachines.updateVirtualMachineOctopusState vm.OctopusGuid OctopusVmState.Normal


//--------------

let createTemplateFromVm (vm:VirtualMachine) =
  if vm.IsCheckpointed then
    failwith "Unable to stamp this VM because it is checkpointed"

  let hfvm = HyperF.HyperF.get_VM (Some vm.CurrentServer) vm.HyperVGuid
  if hfvm.State <> HyperF.VMState.Stopped then
    failwith "Virtual machines need to be stopped to be stamped" 

  let disks = HyperF.HyperF.get_VMDisks hfvm
  let diskPath = disks.[0].Connection.[0]

  let exportTmpPath = vm.StoredPath + "\\ExportTmp"
  let stampsPath = 
      let host = Database.HyperVNodes.getHyperVNodeByName vm.CurrentServer
      let path = Database.GeneralConfig.get_SharedStoragePath ()
      let tmp = if path.EndsWith("\\") then path else (path + "\\")
      sprintf "%sVirtualMachines\\VM Stamps" tmp

  // Step 0: Check the stamps directory
  if not(Directory.Exists(stampsPath)) then
    Directory.CreateDirectory stampsPath |> ignore
  
  // Step 1: Remove the hard drive
  if hfvm.State = HyperF.VMState.Suspended then
    HyperF.HyperF.stop_VM hfvm
  HyperF.HyperF.remove_VMDrive (disks.[0].DiskDrive)
  
  // Step 2: Rename the VHD and move it in the stamps directory
  let name = diskPath.Substring( diskPath.LastIndexOf('\\')+1, diskPath.LastIndexOf('.')-diskPath.LastIndexOf('\\')-1 )
  let templatePath = sprintf "%s\\%s_%d.vhd" stampsPath name (System.DateTime.Now.ToFileTime())
  File.Move(diskPath, templatePath)

  // Step 3: Create the differencing disk and add it to the VM
  HyperF.HyperF.new_VHD_Differencing (Some vm.CurrentServer) diskPath templatePath
  let controllers = HyperF.HyperF.get_VMDiskControllers hfvm
  HyperF.HyperF.add_VMHardDiskToController controllers.[0] 0 diskPath

  // Step 4: Export the VM and delete it
  HyperF.HyperF.exportEx_VM hfvm exportTmpPath false false
  HyperF.HyperF.delete_VM hfvm false |> ignore
  
  // Step 5: Restore the vm metadata
  let path1 = exportTmpPath + "\\Virtual Machines"
  let path2 = vm.StoredPath + "\\Virtual Machines"
  if Directory.Exists(path2) then Directory.Delete(path2, true)
  Utility.trySomeTimes (10,1000) (fun () -> Directory.Move(path1, path2)) |> ignore

  // Step 6: Create the new VM template
  let parentTemplate = Database.VMTemplates.getVMTemplate vm.VmTemplateID
  let name = sprintf "%s|%s|%s" vm.HostName (System.DateTime.Now.ToShortDateString()) (System.DateTime.Now.ToShortTimeString())
  let description = name
  let templateId = Database.VMTemplates.insertNewVMTemplate name description parentTemplate.CpuCoresMin parentTemplate.CpuCoresMax parentTemplate.MemorySizeMbMin parentTemplate.MemorySizeMbMax parentTemplate.NicSwitchName templatePath vm.VmTemplateID false null
  
  // Step 7: Update the VM information in the database
  Database.VirtualMachines.updateVirtualMachineTemplateId vm.OctopusGuid templateId

  // Step 8: Reimport the VM
  let foo () = HyperF.HyperF.importEx_VM (Some vm.CurrentServer) vm.HostName false vm.StoredPath false ""
  Utility.trySomeTimes (5,2000) foo |> ignore


//-------------------------

let deleteVm (octopusGuid:Guid) =
  let vm = Database.VirtualMachines.getVmByOctopusGuid octopusGuid  
  HyperF.HyperF.delete_VM_byName (Some vm.CurrentServer) vm.HyperVGuid true |> ignore
  Database.VirtualMachines.deleteVirtualMachine octopusGuid |> ignore

  let vmStoredPath = sprintf "%s\\Virtual Machines\\%s" vm.StoredPath (vm.HyperVGuid.ToString().ToUpper())

  if Directory.Exists(vmStoredPath) then             
    Utility.trySomeTimes (10,1000) (fun () -> Directory.Delete(vmStoredPath, true)) |> ignore


let startVm (octopusGuid:Guid) =
  let vm = Database.VirtualMachines.getVmByOctopusGuid octopusGuid
  let hfvm = HyperF.HyperF.get_VM (Some vm.CurrentServer) vm.HyperVGuid
  if hfvm.State <> HyperF.VMState.Starting && hfvm.State <> HyperF.VMState.Running then
    Database.VirtualMachines.updateVirtualMachineHyperVStates octopusGuid (Some HyperVState.Starting) None None
    HyperF.HyperF.start_VM hfvm
    Database.VirtualMachines.updateVirtualMachineHyperVStates octopusGuid (Some HyperVState.Running) None None


let turnoffVm (octopusGuid:Guid) =
  let vm = Database.VirtualMachines.getVmByOctopusGuid octopusGuid
  let hfvm = HyperF.HyperF.get_VM (Some vm.CurrentServer) vm.HyperVGuid
  
  if hfvm.State <> HyperF.VMState.Stopping && hfvm.State <> HyperF.VMState.Stopped then
    Database.VirtualMachines.updateVirtualMachineHyperVStates octopusGuid (Some HyperVState.Stopping) None None
    HyperF.HyperF.stop_VM hfvm
    Database.VirtualMachines.updateVirtualMachineHyperVStates octopusGuid (Some HyperVState.Stopped) None None

let suspendVm (octopusGuid:Guid) =
  let vm = Database.VirtualMachines.getVmByOctopusGuid octopusGuid
  let hfvm = HyperF.HyperF.get_VM (Some vm.CurrentServer) vm.HyperVGuid

  if hfvm.State <> HyperF.VMState.Saving && hfvm.State <> HyperF.VMState.Suspended then
    Database.VirtualMachines.updateVirtualMachineHyperVStates octopusGuid (Some HyperVState.Saving) None None
    HyperF.HyperF.suspend_VM hfvm
    Database.VirtualMachines.updateVirtualMachineHyperVStates octopusGuid (Some HyperVState.Suspended) None None
  
let shutdownVm (octopusGuid:Guid) (force:bool) (reason:string) =
  let vm = Database.VirtualMachines.getVmByOctopusGuid octopusGuid
  let hfvm = HyperF.HyperF.get_VM (Some vm.CurrentServer) vm.HyperVGuid
  HyperF.HyperF.shutdown_VM hfvm force reason


//-----------------------------------------------------------------------------------------------------------
//-----------------------------------------------------------------------------------------------------------
//-----------------------------------------------------------------------------------------------------------
(*
#r @"C:\Users\Administrator\Desktop\Marco-tesi\HyperF\HyperF\bin\Debug\HyperF.dll"
#r "System.Management"
open System
open System.IO

let currentServer = "NODE03"
let vmGuid = new Guid("1b5e17d6-3983-4d37-8ad1-d2878d5be524")
let vm = HyperF.HyperF.get_VM (Some currentServer) vmGuid

let octopusStoragePath = @"\\NODE08\OctopusShared"
*)

let private migrateVm_inPlace (vm:VirtualMachine) (dest:HyperVNode) =
  let octopusStoragePath = Database.GeneralConfig.get_SharedStoragePath ()
  let hfvm = HyperF.HyperF.get_VM (Some vm.CurrentServer) vm.HyperVGuid

  let sharedPath = 
      if octopusStoragePath.EndsWith("\\") then sprintf "%sVirtual Machines\\" octopusStoragePath
      else sprintf "%s\\Virtual Machines\\" octopusStoragePath
  let exportBasePath = 
      if octopusStoragePath.EndsWith("\\") then sprintf "%sExport Temp\\" octopusStoragePath
      else sprintf "%s\\Export Temp\\" octopusStoragePath

  let exportPath = exportBasePath + hfvm.Guid.ToString()

  // Step 1: Export the VM without copying the state nor the storage
  HyperF.HyperF.exportEx_VM hfvm exportPath false false

  let path = sharedPath + hfvm.Guid.ToString()

  // Step 2: Moves the vm state to backup it, before deleting the vm
  let exportPath2 = exportBasePath + hfvm.Guid.ToString() + "\\Virtual Machines\\" + hfvm.Guid.ToString();
  Directory.Move(path, exportPath2)

  // Step 3: Delete the vm, without deleting the storage  
  HyperF.HyperF.delete_VM hfvm false |> ignore
  
  try if Directory.Exists(path) then Directory.Delete(path, true)
  with _ -> ()

  try if File.Exists(path + ".xml") then File.Delete(path + ".xml")
  with _ -> ()

  // Step 4: Edit the export xml file, to set that the state was copied
  let path_exp = exportPath2 + ".exp"
  let sb = new System.Text.StringBuilder()
  let sr = new StreamReader(path_exp, System.Text.Encoding.Unicode)
  sb.Append( sr.ReadToEnd() ) |> ignore
  sr.Close()
  let cut = @"<INSTANCE CLASSNAME=""Msvm_VirtualSystemExportSettingData""><PROPERTY NAME=""Caption"" TYPE=""string""><VALUE>Virtual System Export Setting Data</VALUE></PROPERTY><PROPERTY NAME=""CopySnapshotConfiguration"" TYPE=""uint8""><VALUE>0</VALUE></PROPERTY><PROPERTY NAME=""CopyVmRuntimeInformation"" TYPE=""boolean""><VALUE>FALSE"
  let paste = @"<INSTANCE CLASSNAME=""Msvm_VirtualSystemExportSettingData""><PROPERTY NAME=""Caption"" TYPE=""string""><VALUE>Virtual System Export Setting Data</VALUE></PROPERTY><PROPERTY NAME=""CopySnapshotConfiguration"" TYPE=""uint8""><VALUE>0</VALUE></PROPERTY><PROPERTY NAME=""CopyVmRuntimeInformation"" TYPE=""boolean""><VALUE>TRUE"
  sb.Replace(cut, paste) |> ignore
  let sw = new StreamWriter(path_exp, false, System.Text.Encoding.Unicode)
  sw.Write(sb.ToString())
  sw.Flush()
  sw.Close()  

  // Step 5: Restore the backuped state
  // try some times because once, in a test, the Move immediately next the Delete failed
  Utility.trySomeTimes (10,1000) (fun () -> Directory.Move(exportPath2, path)) |> ignore
  let exportFileExt = exportPath2 + ".exp"
  let exportFileDest = sharedPath + "\\" + hfvm.Guid.ToString() + ".exp"
  File.Move(exportFileExt, exportFileDest)

  let exportFileConfig = exportPath + "\\config.xml"
  let exportFileConfigDest = 
      if octopusStoragePath.EndsWith("\\") then sprintf "%s%s.xml" octopusStoragePath (string hfvm.Guid)
      else sprintf "%s\\%s.xml" octopusStoragePath (string hfvm.Guid)
  File.Move(exportFileConfig, exportFileConfigDest)

  Directory.Delete(exportPath, true)
  let x = Directory.EnumerateFileSystemEntries(exportBasePath) |> Seq.toArray
  if x.Length = 0 then
    Directory.Delete(exportBasePath)

  // Step 6: Import the VM in the destination Hyper-V  
  HyperF.HyperF.importEx_VM (Some dest.HostName) hfvm.Name false octopusStoragePath false ""

  // Last step : Remove import data file
  Utility.trySomeTimes (10,1000) (fun () -> File.Delete(exportFileConfigDest)) |> ignore



let migrateVm (octopusVmGuid:Guid) serverDest =
  let vm = Database.VirtualMachines.getVmByOctopusGuid octopusVmGuid  
  let hostSrc = Database.HyperVNodes.getHyperVNodeByName vm.CurrentServer
  let hostDest = Database.HyperVNodes.getHyperVNodeByName serverDest

  if hostSrc.HostName.ToUpper() = hostDest.HostName.ToUpper() then
    failwith "Source and destination hosts are the same"
  
  let vmsumm = HyperF.HyperF.get_VMSummary (Some vm.CurrentServer) vm.HyperVGuid
  if vmsumm.State <> HyperF.VMState.Running && vmsumm.State <> HyperF.VMState.Stopped && vmsumm.State <> HyperF.VMState.Paused && vmsumm.State <> HyperF.VMState.Suspended then
    updateVmState2 vmsumm
    failwith "To migrate a VM it must be in Running, Paused, Saved or Stopped state"

  Database.VirtualMachines.updateVirtualMachineOctopusState octopusVmGuid OctopusVmState.Migrating
  Database.ClipsLogFile.writeInLog (sprintf "Migration of %s started from %s to %s" vm.CurrentServer serverDest (string octopusVmGuid) )
  Database.MessagesToUsers.insertNewMessage vm.OwnerName "Migration started..."

  let startingState = vmsumm.State
  if startingState = HyperF.VMState.Running || startingState = HyperF.VMState.Paused then
    Database.MessagesToUsers.insertNewMessage vm.OwnerName "...suspending the VM..."
    HyperF.HyperF.suspend_VM vmsumm
  
  Database.MessagesToUsers.insertNewMessage vm.OwnerName "...moving the VM..."
  migrateVm_inPlace vm hostDest

  try
    if startingState = HyperF.VMState.Running then
      let vmsumm = HyperF.HyperF.get_VM (Some hostDest.HostName) vm.HyperVGuid
      Database.MessagesToUsers.insertNewMessage vm.OwnerName "...restarting the VM..."
      HyperF.HyperF.start_VM vmsumm
  with _ ->
    Database.MessagesToUsers.insertNewMessage vm.OwnerName "...unable to restart the VM..."
  
  Database.VirtualMachines.updateVirtualMachineServer octopusVmGuid hostDest.HostName
  Database.VirtualMachines.updateVirtualMachineOctopusState octopusVmGuid OctopusVmState.Normal
  Database.MessagesToUsers.insertNewMessage vm.OwnerName "...done!!"
  Database.ClipsLogFile.writeInLog (sprintf "Migration of %s completed." (string octopusVmGuid))
